module Pong (
	updatePong,
	BallState(ballPos),
	PongState(ballState),
	initPong,
	tickMS,
	padXOffset,
	padWidth,
	padHeight,
	ballWidth,
	KeyStates(upPressed, downPressed, qPressed, aPressed),
	initKeyStates,
	Point(Point),
	Pad(Pad1, Pad2),
	padPos
)
where

data Pad = Pad1 | Pad2

padXOffset Pad1 = -0.9::Float
padXOffset Pad2 = 0.9::Float
padHeight = 0.4::Float
padWidth = 0.05::Float
padVel = 1
padDY = padVel * tickMS / 1000

ballWidth = 0.05::Float

data Point a = Point a a deriving (Show)

data BallState = BallState {
	ballPos :: (Point Float),
	ballVel :: (Point Float)
} deriving (Show)

data PongState = PongState {
	p1y :: Float,
	p2y :: Float,
	ballState :: BallState
} deriving (Show)

data Input = None | UpPressed | DownPressed

fps = 30::Float

tickMS = 1000 / fps

data Event =
	PadMoved Pad Float |
	BallMoved |
	BallCollided (Point Int)

data KeyStates = KeyStates {
	upPressed :: Bool,
	downPressed :: Bool,
	qPressed :: Bool,
	aPressed :: Bool
} deriving (Show)

padMoved pad upKey downKey keyStates
	| upKey keyStates = [PadMoved pad padDY]
	| downKey keyStates = [PadMoved pad (-padDY)]
	| otherwise = []

processInput keyStates =
	(padMoved Pad1 qPressed aPressed keyStates) ++
	(padMoved Pad2 upPressed downPressed keyStates)

newBallPos BallState { ballPos = Point x y, ballVel = Point vx vy } =
	Point (x + vx * tickMS / 1000) (y + vy * tickMS / 1000)

processEvent (PadMoved Pad1 dy) state = state { p1y = (p1y state) + dy }
processEvent (PadMoved Pad2 dy) state = state { p2y = (p2y state) + dy }
processEvent BallMoved state =
	state { ballState = bs { ballPos = newBallPos bs } }
	where bs = ballState state
processEvent (BallCollided normal) state@(PongState {ballState = bs@(BallState {ballVel = v}) }) =
	state { ballState = bs { ballVel = invertVel v normal } }

invertVel (Point x y) (Point u 0) = Point (-x) y
invertVel (Point x y) (Point 0 v) = Point x (-y)

initKeyStates = KeyStates False False False False
initBallState = BallState (Point 0 0) (Point 0.5 0.5)
initPong = PongState { p1y = 0, p2y = 0, ballState = initBallState }

padYOffset Pad1 state = p1y state
padYOffset Pad2 state = p2y state

padPos pad state = Point (padXOffset pad) (padYOffset pad state)

corners (Point x y) w h = (x - w / 2, x + w / 2, y - h / 2, y + h / 2)

intersect (left1, right1, top1, bottom1) (left2, right2, top2, bottom2)
	| right1 < left2 = False
	| left1 > right2 = False
	| bottom1 < top2 = False
	| top1 > bottom2 = False
	| otherwise = True

ballCorners state = corners (ballPos $ ballState $ state) ballWidth ballWidth

padCorners pad state = corners (padPos pad state) padWidth padHeight

checkBallPadCollision pad state =
	intersect (padCorners pad state) (ballCorners state)

topWall = corners (Point 0 (-2)) 2 2
bottomWall = corners (Point 0 2) 2 2
leftWall = corners (Point (-2) 0) 2 2
rightWall = corners (Point 2 0) 2 2

checkCollisionWithWalls state
	| intersect ball topWall    = [ BallCollided (Point 0 1) ]
	| intersect ball bottomWall = [ BallCollided (Point 0 (-1)) ]
	| intersect ball leftWall   = [ BallCollided (Point 1 0) ]
	| intersect ball rightWall  = [ BallCollided (Point (-1) 0) ]
	| otherwise = []
	where ball = ballCorners state

checkCollisionWithPads state
	| checkBallPadCollision Pad1 state = [ BallCollided (Point 1 0) ]
	| checkBallPadCollision Pad2 state = [ BallCollided (Point (-1) 0) ]
	| otherwise = []

updatePong keyStates state = foldr processEvent state events
	where events =
		[BallMoved] ++
		(processInput keyStates) ++
		(checkCollisionWithPads state) ++
		(checkCollisionWithWalls state)

